#!/usr/bin/perl

use Net::Jabber;
use LWP::Simple;
use XML::RSS;
use HTML::Strip;

use strict;

use constant SERVER   => 'jabber.mauch.name';
use constant PORT     => 5222;
use constant USER     => 'bot';
use constant PASSWORD => 'password';
use constant RESOURCE => 'headlines';
use constant DELAY    => 3600;
use constant VERBOSE  => 3;

my %present;
my %cache;

my @sources = ( 'http://leo.am/podcasts/twit',
                'http://feeds.feedburner.com/diggnation',
                'http://www.itconversations.com/rss/recentWithEnclosures.php',
                'http://www.pbs.org/cringely/nerdtv/rss/nerdtv-ogg.xml',
                'http://rss.slashdot.org/Slashdot/slashdot',
                'http://www.digg.com/rss/indexlinux_unix.xml',
                'http://www.digg.com/rss/indexprogramming.xml',
              );

my $connection = Net::Jabber::Client->new();

log3( "Making connection to Jabber server" );
$connection->Connect( hostname => SERVER,
                      port     => PORT
                    ) or die "Cannot connect ($!)\n";

log3( "Attempting Ident/Auth" );
my @result = $connection->AuthSend( username => USER,
                                    password => PASSWORD,
                                    resource => RESOURCE
                                  );

if ( $result[0] ne "ok" ) {
    die "Ident/Auth with server failed: $result[0] - $result[1]\n";
}

log3( "Setting headline handler" );
$SIG{ ALRM } = \&do_headlines;

log3( "Setting presence handler" );
$connection->SetCallBacks( presence => \&handle_presence );

log3( "Requesting roster" );
$connection->RosterGet();

log3( "Sending presence" );
$connection->PresenceSend();

log3( "Retrieving RSS for first time and setting alarm" );
do_headlines();

log3( "Entering main loop" );
while ( defined( $connection->Process() ) ) { }

log3( "Cancelling alarm" );
alarm( 0 );

print "ERROR: The connection was killed...\n";

exit( 0 );

sub do_headlines {

    foreach my $source ( @sources ) {

        # Retrieve the RSS
        log3( "Getting $source" );
        my $data = get( $source );

        # Skip if cannot retrieve
        unless ( defined( $data ) ) {
            log1( "Cannot retrieve $source - skipping" );
          next;
        }

        # Process any messages
        $connection->Process( 1 );

        my $rss = XML::RSS->new();

        # Parse the RSS and get the items
        $rss->parse( $data );
        my @items = @{ $rss->{ items } };

        # Discover any new items
        log3( "Looking for new items" );
        foreach my $item ( @items ) {

            # Stop looking if we reach an item we've
            # already seen
          last
              if exists $cache{ $source }
              and $cache{ $source } eq $item->{ link };

            log2( "New item from $source - $item->{title}" );

            # Create headline message
            my $msg = Net::Jabber::Message->new();

            my $hs         = HTML::Strip->new();
            my $clean_text = $hs->parse( $item->{ description } );
            $hs->eof;
            my $new_text = "$item->{link}\n\n$clean_text";
            $new_text =~ tr/ / /s;

            $msg->SetMessage( type    => 'headline',
                              subject => "$item->{title}",
                              body    => $new_text,
                            );

            my $oob = $msg->NewX( 'jabber:x:oob' );
            $oob->SetURL( $item->{ link } );
            $oob->SetDesc( $item->{ title } );

            my @sendees;

            # Send the headline to all that are present
            foreach my $recipient ( keys %present ) {
                $msg->SetTo( $recipient );
                $connection->Send( $msg );
                push @sendees, $recipient;
            }

            log2( "Sent to " . ( join( ", ", @sendees ) || "nobody" ) );

            # This will prevent all the items being
            # counted as new the first time through
            # the loop (but allows the first item in
            # the RSS to be sent).
          last unless exists( $cache{ $source } );

        } ## end foreach my $item ( @items )

        # Remember the latest new item
        $cache{ $source } = $items[0]->{ link };

    } ## end foreach my $source ( @sources)

    log3( "Setting alarm" );
    alarm( DELAY );
} ## end sub do_headlines

sub handle_presence {
    my ( $sid, $presence ) = @_;
    my $jid  = $presence->GetFrom();
    my $show = $presence->GetShow();
    my $type = $presence->GetType();

    $jid =~ s!\/.*$!!;    # remove any resource suffix from JID

    log3( "Presence from $jid:\n" . $presence->GetXML() );

    # Subscription request:
    # Accept, and request subscription to them.
    if ( $type eq "subscribe" ) {
        log3( "$jid requests subscription" );
        $connection->Send( $presence->Reply( type => 'subscribed' ) );
        $connection->Send( $presence->Reply( type => 'subscribe' ) );
    }

    # Request to unsubscribe:
    # Acknowledge, and request unsubscription from them.
    # Don't forget to remove them from the present list, too.
    if ( $type eq "unsubscribe" ) {
        log3( "$jid requests unsubscription" );
        $connection->Send( $presence->Reply( type => 'unsubscribed' ) );
        $connection->Send( $presence->Reply( type => 'unsubscribe' ) );
        delete $present{ $jid };
    }

    # User has disconnected
    if ( $type eq "unavailable" ) {
        log3( "$jid unavailable" );
        delete $present{ $jid };
    }

    # Default presence information (type is blank)
    if ( $type eq "" ) {

        # We'll count normal, chat and away as valid
        # present stati for sending headlines to
        if ( $show =~ /^(chat|away|xa|)$/i ) {
            log3( "$jid available (" . ( $show || "online" ) . ")" );
            $present{ $jid } = 1;
        } else {
            log3( "$jid not available" );
            delete $present{ $jid };
        }
    } ## end if ( $type eq "" )
} ## end sub handle_presence

sub log1 {

    # WARN
    my $msg = shift;
  return unless VERBOSE >= 1;
    print STDERR "WARN: $msg\n";
}

sub log2 {

    # INFO
    my $msg = shift;
  return unless VERBOSE >= 2;
    print STDERR "INFO: $msg\n";
}

sub log3 {

    # DBUG
    my $msg = shift;
  return unless VERBOSE >= 3;
    print STDERR "DBUG: $msg\n";
}

